home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Controls / Visual Basic Controls.iso / vbcontrol / cpkocx17 / cardpack.bas < prev    next >
Encoding:
BASIC Source File  |  1998-09-05  |  5.7 KB  |  209 lines
  1. '---------------------------------------------------------------------------
  2. ' CARDPACK.BAS - Copyright(c) 1995..1998 by Andy Zanna
  3. '---------------------------------------------------------------------------
  4. ' Definitions and constants for use with the
  5. ' Cardpack Control, up to version 1.7
  6. '
  7. ' Notes:
  8. ' - Not all of these are applicable to older versions and VBX variants 
  9. ' - The ActiveX variants of the control also has equivalent constants
  10. '   defined in its type library. These can be accessed from Visual Basic's
  11. '   "Object Browser" (hit F2 key) 
  12. '---------------------------------------------------------------------------
  13.  
  14. ' these are usually found as return values from properties and queries
  15. Global Const CARD_EMPTY = 0  ' a card VALUE, indicate 'no cards in this position
  16. Global Const CARD_NONE = -1  ' a card INDEX, indicates 'no such card'
  17.  
  18. Global Const ACE = 1
  19. Global Const JACK = 11
  20. Global Const QUEEN = 12
  21. Global Const KING = 13
  22. Global Const JOKER = 14
  23.  
  24. Global Const HEARTS = &H10
  25. Global Const DIAMONDS = &H20
  26. Global Const CLUBS = &H30
  27. Global Const SPADES = &H40
  28.  
  29. ' used in: For s% = HEARTS To SPADES Step ONE_SUIT ...
  30. Global Const ONE_SUIT = &H10
  31.  
  32. Global Const FACING_DOWN = &H100
  33. Global Const FACING_UP = &H200
  34.  
  35.  
  36. ' This is the available range for card backs.
  37. ' You should specify your preferred backs with your own constants.
  38.  
  39. Global Const CARD_FIRST_BACK = &H1000
  40. Global Const CARD_LAST_BACK = &HF000
  41.  
  42.  
  43.  
  44. '---------------------------------------------------------------------------
  45. ' Enumerated values for the Control properties
  46. '---------------------------------------------------------------------------
  47.  
  48. ' *** Sorting ***
  49. Global Const CARDS_SORT_BYSUIT = 0
  50. Global Const CARDS_SORT_BYVAL = 1
  51.  
  52.  
  53. ' *** Spread Style ****
  54. Global Const CARDS_SPREAD_STACKED = 0
  55. Global Const CARDS_SPREAD_SLANTED = 1
  56. Global Const CARDS_SPREAD_TIGHT = 2
  57. Global Const CARDS_SPREAD_WIDE = 3
  58. Global Const CARDS_SPREAD_STREWN = 4
  59. Global Const CARDS_SPREAD_USERDEF = 5
  60.  
  61.  
  62. '*** Spread Direction ***
  63. Global Const CARDS_SPREAD_UP = 0
  64. Global Const CARDS_SPREAD_DOWN = 1
  65. Global Const CARDS_SPREAD_RIGHT = 2
  66. Global Const CARDS_SPREAD_LEFT = 3
  67. Global Const CARDS_SPREAD_UP_RIGHT = 4
  68. Global Const CARDS_SPREAD_UP_LEFT = 5
  69. Global Const CARDS_SPREAD_DOWN_RIGHT = 6
  70. Global Const CARDS_SPREAD_DOWN_LEFT = 7
  71.  
  72.  
  73. ' *** EmptyPicture ****
  74. Global Const CARDS_EMPTY_NONE = 0
  75. Global Const CARDS_EMPTY_CROSS = 1
  76. Global Const CARDS_EMPTY_CIRCLE = 2
  77.  
  78.  
  79. ' *** Stack Facing Direction ****
  80. Global Const CARDS_FACING_DOWN = 0
  81. Global Const CARDS_FACING_UP = 1
  82.  
  83.  
  84. ' -------------------------------------------------------------------
  85. ' Cards actions (synchronous methods) and Msgs logged by the
  86. ' logger itself after an action was issued.
  87. '
  88. ' These commands are issued by assigning one of the values below
  89. ' to the property "Action=". This is required since VB has no way
  90. ' to extend the standard set of methods for a custom control.
  91. ' -------------------------------------------------------------------
  92.  
  93. Global Const CARDS_ACTION_NONE = 0
  94. Global Const CARDS_ACTION_SHUFFLE = 1
  95. Global Const CARDS_ACTION_SORT = 2
  96. Global Const CARDS_ACTION_TURN_UP = 3
  97. Global Const CARDS_ACTION_TURN_DOWN = 4
  98. Global Const CARDS_ACTION_DESELECT = 5
  99. Global Const CARDS_ACTION_SELECT = 6
  100. Global Const CARDS_ACTION_PACK = 7
  101. Global Const CARDS_ACTION_CLEAR = 8
  102.  
  103. ' -------------------------------------------------------------------
  104. ' Cards descriptor bits (just in case you need to interpret a
  105. ' descriptor after it has been extracted
  106. ' -------------------------------------------------------------------
  107.  
  108. Global Const CARD_VALUE_BITS = &HF
  109. Global Const CARD_SUIT_BITS = &HF0
  110. Global Const CARD_FACING_BITS = &H300
  111. Global Const CARD_BACK_BITS = &HF000
  112. Global Const CARD_SELECT_BIT = &H800
  113.  
  114. '
  115. ' Return the attribute as bit pattern (not numeric value)
  116. '
  117. Function CardBack(c%) As Integer
  118.     CardBack = c% And CARD_BACK_BITS
  119. End Function
  120.  
  121. '
  122. ' Return the attribute as bit pattern (not numeric value)
  123. '
  124. Function CardFacing(c%) As Integer
  125.     CardFacing = c% And CARD_FACING_BITS
  126. End Function
  127.  
  128. '
  129. ' Reverse card
  130. '
  131. Function CardFlip(c%) As Integer
  132.     
  133.     Dim curr_facing%
  134.  
  135.     curr_facing% = c% And CARD_FACING_BITS
  136.  
  137.     CardFlip = c% And (Not CARD_FACING_BITS) Or (CARD_FACING_BITS And (Not curr_facing%))
  138.  
  139. End Function
  140.  
  141. '
  142. ' Return the attribute as bit pattern (not numeric value)
  143. '
  144. Function CardSelection(c%) As Integer
  145.     CardSelection = c% And CARD_SELECT_BIT
  146. End Function
  147.  
  148. '
  149. ' Return the attribute as bit pattern (not numeric value)
  150. '
  151. Function CardSuit(c%) As Integer
  152.     CardSuit = c% And CARD_SUIT_BITS
  153. End Function
  154.  
  155. '
  156. ' Return the attribute as bit pattern (not numeric value)
  157. '
  158. Function CardValue(c%) As Integer
  159.     CardValue = c% And CARD_VALUE_BITS
  160. End Function
  161.  
  162. '
  163. ' Returns human name of a card
  164. '
  165. Function CardName$(c%)
  166.     Dim v$, s$
  167.     
  168.     If c% = CARD_EMPTY Then
  169.         CardName$ = "Empty"
  170.         Exit Function
  171.     End If
  172.     
  173.     Select Case CardValue(c%)
  174.         Case ACE
  175.             v$ = "Ace"
  176.         Case JACK
  177.             v$ = "Jack"
  178.         Case QUEEN
  179.             v$ = "Queen"
  180.         Case KING
  181.             v$ = "King"
  182.         Case JOKER
  183.             v$ = "Joker"
  184.         Case Else
  185.             v$ = Str$(CardValue(c%))
  186.     End Select
  187.     
  188.     Select Case CardSuit(c%)
  189.         Case SPADES
  190.             s$ = "Spades"
  191.         Case CLUBS
  192.             s$ = "Clubs"
  193.         Case DIAMONDS
  194.             s$ = "Diamonds"
  195.         Case HEARTS
  196.             s$ = "Hearts"
  197.         Case Else
  198.             s$ = ""
  199.     End Select
  200.     
  201.     If s$ <> "" Then
  202.         CardName$ = v$ & " of " & s$
  203.     Else
  204.         CardName$ = v$
  205.     End If
  206.     
  207. End Function
  208.  
  209.